home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / DB_CLIPP / 0643C.ZIP / PAGES.SRC < prev    next >
Text File  |  1986-11-18  |  7KB  |  280 lines
  1. * pages.src
  2. * pages procedures file
  3. * Andrew Schulman, 12 Humboldt St., Cambridge MA 02140
  4. * 11/16/86
  5.  
  6. procedure PAGES
  7. parameters filename, MYTOP, DEPTH, START, SHOWPAGE, SHOWRULE
  8.  
  9. store space(10) to whichpage, phrase, otherfile
  10.  
  11. if DEPTH + START > 22 .or. START > 22 .or. SHOWPAGE > START .or. ;
  12.    SHOWRULE > START
  13.    @3,0 say "PAGES won't fit on screen or SHOWPAGE/SHOWRULE won't show"
  14.    @4,0 say "Correct example:  do PAGES with 'pages.src', 1, 19, 3, 1, 2"
  15.    return
  16. endif
  17. if .not. file(filename)
  18.    @START,0 say "PAGES can't find " + filename
  19.    return
  20. endif
  21.  
  22. msgline = START + DEPTH + 1
  23. @START,0 clear to msgline-2,79
  24. @START,0 say "Working...."
  25. do BLINKY
  26.  
  27. * scan codes for PC keys
  28. UP = 5
  29. DOWN = 24
  30. PGUP = 18
  31. PGDN = 3
  32. HOME = 1
  33. ENDKEY = 6
  34.  
  35. set heading off
  36. load curson
  37. load cursoff
  38. * DEMO.PRG checked to make sure these existed; your calling program should too
  39. call cursoff
  40. do SHOW_REV with filename, SHOWPAGE, 0
  41. **** if you don't want to show filename, delete preceding line
  42.  
  43. use line
  44. if len(line) > 78
  45.    @START,0 say "Please use LINE.DBF that comes with PAGES: 78 chars wide"
  46.    do BYE_BYE
  47.    return
  48. endif
  49. set safety off
  50. zap
  51. set safety on
  52. append from &filename sdf
  53. go bottom
  54. do while len(trim(line)) < 1
  55.    delete
  56.    skip -1
  57. enddo
  58. pack
  59. * would have like to have used append from &filename for... sdf, but that
  60. * would kill blank lines in middle of file too!
  61.  
  62. if reccount() < 1
  63.    do WAIT_MSG with "File is empty"
  64.    do BYE_BYE
  65.    return
  66. endif
  67.  
  68. page = 1
  69. size = reccount() + 1 - MYTOP
  70. p = size / DEPTH
  71. q = int(p)
  72. pages = iif(p - q = 0, q, q + 1)
  73. end = iif(size < DEPTH, 1, size - DEPTH + START)
  74. foundit = 0
  75. didsearch = .F.
  76. overlap = 0     && this can be changed to anything < DEPTH
  77.  
  78. if SHOWRULE > 0
  79.    @SHOWRULE,0 to SHOWRULE,78 double
  80. endif
  81. @msgline-1,0 to msgline-1,78 double
  82.  
  83. goto MYTOP
  84. do while .not. eof()
  85.    thispage = "Page " + str(page,2) + " of " + str(pages,2)
  86.    do SHOW_REV with thispage, SHOWPAGE, 66
  87.    @START,0 clear to msgline-2,79
  88.    @START-1,79        && see Liskin, Adv dBase III, p.286, for reason
  89.    if recno() <> MYTOP
  90.       skip overlap + 1
  91.    endif
  92.  
  93.    list off trim(line) next DEPTH
  94.    ** all the work is done here
  95.    ** nonprocedural list is 20% faster than procedural do-while loop
  96.    ** and there is another 20% improvement when you trim line
  97.  
  98.    if foundit > 0
  99.       saverec = min(recno(), reccount() - 1)
  100.       goto foundit
  101.       set color to N/W+
  102.       @START,1 say trim(line)  && why trouble if first few lines?
  103.       set color to
  104.       goto saverec
  105.       foundit = 0
  106.    endif
  107.  
  108.    do MSG with iif(pages = 1, "", ;
  109.       "Prev, Next, Begin, End, Search, Repeat, #, ") + "File, or Quit? "
  110.    ink = 0
  111.    do while ink = 0
  112.       ink = inkey()
  113.    enddo
  114.    which = upper(chr(ink))
  115.    num = val(which)
  116.  
  117.    if pages = 1
  118.       do case
  119.          case which = 'F'
  120.             do NEW_FILE
  121.          case which = 'Q'
  122.             do BYE_BYE
  123.             return
  124.          otherwise
  125.             do WAIT_MSG with "Only one page"
  126.             do GO_HOME
  127.       endcase
  128.    else
  129.       do case
  130.          case which = 'B' .or. ink = HOME
  131.             do GO_HOME
  132.          case which = 'E' .or. ink = ENDKEY
  133.             do GO_END
  134.          case which = 'P' .or. ink = UP .or. ink = PGUP
  135.             do GO_PREV
  136.          case which = 'N' .or. ink = DOWN .or. ink = PGDN
  137.             do GO_NEXT
  138.         case num > 0   && it's a page number
  139.             do GO_PAGE with num
  140.          case which = '#'   && if can't get to page with 1 digit
  141.             do ACCEPTVAR with "Go to page #", whichpage
  142.             mypage = val(whichpage)
  143.             do GO_PAGE with mypage
  144.          case which $ "SR"
  145.             if which = 'S'
  146.                do ACCEPTVAR with "Search for ", phrase
  147.             endif
  148.             if which = 'S' .or. (which = 'R' .and. didsearch)
  149.                do MSG with "Searching for " + phrase + "..."
  150.             endif
  151.             saverec = iif(recno() - DEPTH > 1, recno() - DEPTH, 1)
  152.             if .not. eof()
  153.                goto saverec + 1
  154.             endif
  155.             if which = 'S'
  156.                locate for at(phrase, line) > 0
  157.                didsearch = .T.
  158.             else if which = 'R'
  159.                if didsearch
  160.                   continue
  161.                else
  162.                   do WAIT_MSG with "Must do SEARCH before REPEAT"
  163.                endif
  164.             endif
  165.             **** replaced do-while loop with locate/continue
  166.             if .not. found()
  167.                if didsearch
  168.                   do WAIT_MSG with "Not found"
  169.                endif
  170.                goto saverec
  171.             else
  172.                foundit = recno()
  173.                skip -1 && back up so they can see it
  174.                page = int(((recno() - MYTOP) / DEPTH) + 1)
  175.             endif
  176.          case which = 'F'
  177.             do NEW_FILE
  178.             **** you might not want this in your applications:
  179.             **** just substitute "do GO_NEXT"
  180.          case which = 'Q'
  181.             do BYE_BYE
  182.             return
  183.          otherwise  && same as 'N'
  184.             do GO_NEXT
  185.       endcase
  186.    endif
  187. enddo
  188. return
  189.  
  190. procedure GO_HOME
  191.    goto MYTOP
  192.    page = 1
  193. return
  194.  
  195. procedure GO_END
  196.    goto end
  197.    page = pages
  198. return
  199.  
  200. procedure GO_PREV
  201.    prev = iif(recno() > (DEPTH*2+1), recno()-(DEPTH*2), MYTOP)
  202.    goto prev
  203.    page = iif(page > 1, page - 1, 1)
  204. return
  205.  
  206. procedure GO_NEXT
  207.    goto iif(eof(), recno() - DEPTH + 1, recno())
  208.    page = iif(page < pages - 1, page + 1, pages)
  209. return
  210.  
  211. procedure GO_PAGE
  212. parameter pg
  213.    pg = iif(pg <= 1, 1, int(pg))
  214.    goto iif(pg >= pages, end, ((pg - 1) * DEPTH) + MYTOP - iif(pg = 1, 0, 1))
  215.    page = iif(pg >= pages, pages, pg)
  216. return
  217.  
  218. procedure MSG
  219. parameter msg
  220.    @msgline,0 clear
  221.    @msgline,0 say msg
  222.    do BLINKY
  223. return
  224.  
  225. procedure WAIT_MSG
  226. parameter msg
  227.    @msgline,len(msg)+31
  228.    do BLINKY
  229.    @msgline-1,79
  230.    wait msg + " ... Press any key to continue"
  231.    @msgline,0
  232. return
  233.  
  234. procedure ACCEPTVAR
  235. parameters msg, var
  236.    @msgline,0
  237.    @msgline,len(msg)
  238.    do BLINKY
  239.    @msgline-1,79
  240.    accept msg to temp
  241.    var = temp
  242.    * var has to be declared PUBLIC
  243. return
  244.  
  245. procedure BYE_BYE
  246.    close databases
  247.    call curson
  248.    @msgline,0
  249. return
  250.  
  251. procedure SHOW_REV
  252. parameters msg, row, col
  253.    @row,col
  254.    @row,col get msg
  255.    clear gets
  256. return
  257.  
  258. procedure NEW_FILE
  259.    saverec = iif(recno() - DEPTH > 1, recno() - DEPTH, 1)
  260.    do ACCEPTVAR with "New filename to switch to? ", otherfile
  261.    if file(otherfile)
  262.       * not supposed to do recursion, but...
  263.       do MSG with "Switching file..."
  264.       * it'll surprise them to see two blinking cursors!
  265.       do PAGES with otherfile, MYTOP, DEPTH, START, SHOWPAGE, SHOWRULE
  266.       * after recursion, DON'T pick up where we left off...
  267.       do BYE_BYE
  268.       return to master
  269.    else
  270.       do WAIT_MSG with "No such file"
  271.       goto saverec
  272.    endif
  273. return
  274.  
  275. procedure BLINKY     && our own blinking cursor: don't call curson
  276.    set color to w*
  277.    ?? '_'
  278.    set color to
  279. return
  280.